MacHack 1996/MacHack 1996.toast/Hacks/Hacks ’93/Jon’s FKEYs/GrabColor ƒ/GrabColor FKEY.p

Text File | 1992-10-04 | 9.8 KB | 337 lines | [TEXT/PJMM]

{    GrabColorFKEY FKEY © 1992 by Jon Wind                                                    }
{    Version 1.0 on 9/26/92                                                                        }

{    This FKEY lets you draw a rectangle on the screen and displays it's coordinates.        }

{     Thanks to Brad Pettit and his colorfkey for his method of conditional compilation.        }

{    To execute this as a program...                                                                }
{        1. change the definition of fkey to false                                                }
{        2. set the project type to application                                                    }
{        3. change the library from drvrruntime.lib to µruntime.lib                            }
{        4. rebuild the project}


{$setc fkey := true}

{$ifc fkey}

unit GrabColorFKEY;

interface

    uses
        Picker;

    procedure main;

implementation

{$elsec}

    program GrabColorFKEY;

        uses
            Picker;

{$endc}

        procedure main;
            const
                vers = 'v1.0';
                enterKey = 3;
                lastValIndex = 8;
                bCommandKey = 48;
                bShiftKey = 63;
                bControlKey = 60;
                bOptionKey = 61;
                bCapsLockKey = 62;
            type
                myIntArray = array[0..lastValIndex] of LongInt;
                myLabelArray = array[0..lastValIndex] of string[2];
                altCursRec = packed array[1..68] of Byte;
            var
                p: grafport;
                sampleRect, theRect, menuRect: Rect;
                savePort: GrafPtr;
                CMenuPtr: MCEntryPtr;
                theEvent: EventRecord;
                done, usingColor, eraseMBar, updateSample: Boolean;
                thePoint, oldPoint: Point;
                h, i, theFont, baseLine, menuHeight: Integer;
                LabelArray: myLabelArray;
                oldIntArray, IntArray, WidthArray: myIntArray;
                gCurs: Cursor;
                long: LongInt;
                theStr: str255;
                equalStr, openCmtStr, closeCmtStr: string[3];
                oPix, cPix: RGBColor;
                hColor: HSVColor;
                cColor: CMYColor;
                fInfo: FontInfo;


{•   function GetMBarHeight: Integer;•}
{•    { get current menu bar height •]}
{•    var•}
{•     thePtr: ^Integer;•}
{•   begin•}
{•    thePtr := Pointer($BAA);•}
{•    GetMBarHeight := thePtr^;•}
{•   end;  { of func GetMBarHeight •]}

            function GetMBarHeight: INTEGER;
            inline
                $3EB8, $0BAA;

            function IsColor: Boolean;
    { return true if using 16 or more "colors" }
                var
                    maindevice: GDHandle;
                    theWorld: SysEnvRec;
            begin
                IsColor := False;
                if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call available? }
                    if theWorld.hasColorQD then        { has Color QuickDraw }
                        IsColor := True;
            end;{ of func IsColor }

            function myGetGrayRgn: Handle;
    { get current gray region }
                var
                    thePtr: ^Handle;
            begin
                thePtr := Pointer($9EE);
                myGetGrayRgn := thePtr^;
            end;  { of func GetGrayRgn }

            function GetKeyDown (index: Integer): Boolean;
    { return the state of the desired key - true if down; false if up }
                var
                    keys: keymap;
            begin
                GetKeys(keys);
                GetKeyDown := bittst(@keys, index);        { look at entry within the key map }
            end;

            function aNum2Str (aNum: LongInt): Str255;
    { NumToString procedure available as a function }
                var
                    NumStr: Str255;
            begin
                NumToString(aNum, NumStr);
                aNum2Str := NumStr;
            end;

            procedure CompareAndFixCursor;
    { compare current and expected cursors and adjust as needed }
                var
                    i: Integer;
                    currentCurs: ^Cursor;
            begin
                currentCurs := Pointer($844);
                for i := 1 to 68 do            { compare current and expected cursors and adjust as needed }
                    if altCursRec(currentCurs^)[i] <> altCursRec(gCurs)[i] then
                        begin
                            SetCursor(gCurs);
                            leave;
                        end;
            end;  { of proc CompareAndFixCursor }


 { --------- Main Procedure --------- }
        begin
            GetPort(savePort);            { save current grafport }

            usingColor := IsColor;
            if usingcolor then
                begin
                    OpenCPort(@p);            { open as current port }
                    CMenuPtr := GetMCEntry(0, 0);
                    if CMenuPtr <> nil then
                        begin
                            RGBForeColor(CMenuPtr^.mctRGB1);
                            RGBBackColor(CMenuPtr^.mctRGB4);
                        end;

                    LabelArray[0] := 'R:';
                    LabelArray[1] := 'G:';
                    LabelArray[2] := 'B:';
                    LabelArray[3] := 'H:';
                    LabelArray[4] := 'S:';
                    LabelArray[5] := 'V:';
                    LabelArray[6] := 'C:';
                    LabelArray[7] := 'M:';
                    LabelArray[8] := 'Y:';
                    done := False;
                    updateSample := False;
                    eraseMBar := False;
                    for i := 0 to lastValIndex do
                        IntArray[i] := Random;

                    oPix.red := Random;
                    oPix.green := Random;
                    oPix.blue := Random;
                    SetPt(oldPoint, maxint, maxint);
                    StuffHex(Pointer(@gCurs), '000E001F001F00FF007E00B801180228044008801100220044004800B0004000000E001F001F00FF007E00F801F803E807C00F801F003E007C007800F0004000000F0001');

                    GetFNum('Geneva', theFont);
                    TextFont(theFont);
                    TextSize(9);
                    GetFontInfo(fInfo);
                    menuHeight := GetMBarHeight;
{•     baseLine := Pred(((menuHeight - (fInfo.ascent + fInfo.descent)) div 2) + fInfo.ascent);•}
                    baseLine := Pred(((menuHeight - fInfo.ascent) div 2) + fInfo.ascent);    { NO DESCENDERS USED! }
                    SetRect(menuRect, 1, 0, p.portrect.right, menuHeight - 1);
                    EraseRoundRect(menuRect, 12, 12);

                    TextFace([bold]);
                    Moveto(6, baseLine);
                    DrawString('GrabColor FKEY by Jon Wind.');
                    TextFace([]);
                    DrawString(' Click on a color. Press a key to end.');

                    SetRect(sampleRect, 0, menuRect.top + 2, 21, menuRect.bottom - 2);

                    repeat
                        repeat
                            CompareAndFixCursor;
                        until GetOSEvent(EveryEvent, theEvent);

                        case theEvent.what of
                            autokey, keyDown:
                                begin
                                    done := True;
                                    if (BitAnd(theEvent.message, CharCodeMask) = enterKey) and eraseMBar then    { copy to scrap if Enter key pressed }
                                        begin
                                            if GetKeyDown(bCapsLockKey) then        { test for caps lock down }
                                                begin
                                                    equalStr := '=';
                                                    openCmtStr := '/* ';
                                                    closeCmtStr := ' */';
                                                end
                                            else
                                                begin
                                                    equalStr := ':=';
                                                    openCmtStr := '{* ';
                                                    closeCmtStr := ' *}';
                                                end;
                                            theStr := Concat(openCmtStr, 'RGB Model', closeCmtStr);
                                            theStr := Concat(theStr, chr(13), 'red', equalStr, aNum2Str(IntArray[0]), ';green', equalStr, aNum2Str(IntArray[1]), ';blue', equalStr, aNum2Str(IntArray[2]), ';');
                                            theStr := Concat(theStr, chr(13), openCmtStr, 'HSV Model', closeCmtStr);
                                            theStr := Concat(theStr, chr(13), 'hue', equalStr, aNum2Str(IntArray[3]), ';saturation', equalStr, aNum2Str(IntArray[4]), ';value', equalStr, aNum2Str(IntArray[5]), ';');
                                            theStr := Concat(theStr, chr(13), openCmtStr, 'CMY Model', closeCmtStr);
                                            theStr := Concat(theStr, chr(13), 'cyan', equalStr, aNum2Str(IntArray[6]), ';magenta', equalStr, aNum2Str(IntArray[7]), ';yellow', equalStr, aNum2Str(IntArray[8]), ';');
                                            if ZeroScrap = noErr then
                                                long := PutScrap(Length(theStr), 'TEXT', Pointer(@theStr[1]));
                                        end;
                                end;
                            mouseDown:
                                begin
                                    if not eraseMBar then
                                        begin
                                            EraseRoundRect(menuRect, 12, 12);            { clear menu bar area }
                                            TextFace([bold]);
                                            moveto(10, baseLine);
                                            for i := 0 to lastValIndex do
                                                begin
                                                    WidthArray[i] := StringWidth(LabelArray[i]);
                                                    DrawString(LabelArray[i]);
                                                    move(40, 0);

                                                    if Succ(i) mod 3 = 0 then
                                                        move(30, 0);

                                                    oldIntArray[i] := maxint;
                                                end;
                                            TextFace([]);
                                            MoveTo(menuRect.right - StringWidth(Vers) - 5, baseLine);
                                            DrawString(Vers);
                                            eraseMBar := True;
                                        end;

                                    repeat
                                        GetMouse(thePoint);
                                        if not EqualPt(thePoint, oldPoint) then
                                            GetCPixel(thePoint.h, thePoint.v, cPix);
                                        oldPoint := thePoint;

                                        if (cPix.red <> oPix.red) | (cPix.green <> oPix.green) | (cPix.blue <> oPix.blue) then
                                            begin
                                                oPix := cPix;

                                                RGB2HSV(cPix, hColor);
                                                RGB2CMY(cPix, cColor);
                                                IntArray[0] := SmallFract2Fix(cPix.red);
                                                IntArray[1] := SmallFract2Fix(cPix.green);
                                                IntArray[2] := SmallFract2Fix(cPix.blue);
                                                IntArray[3] := SmallFract2Fix(hColor.hue);
                                                IntArray[4] := SmallFract2Fix(hColor.saturation);
                                                IntArray[5] := SmallFract2Fix(hColor.value);
                                                IntArray[6] := SmallFract2Fix(cColor.cyan);
                                                IntArray[7] := SmallFract2Fix(cColor.magenta);
                                                IntArray[8] := SmallFract2Fix(cColor.yellow);

                                                h := 0;
                                                for i := 0 to lastValIndex do
                                                    begin
                                                        h := h + WidthArray[i];
                                                        SetRect(theRect, 12 + (40 * i) + h, menuRect.top, (40 * i) + h + 50, menuRect.bottom);
                                                        moveto(theRect.left, baseLine);
                                                        if IntArray[i] <> oldIntArray[i] then
                                                            begin
                                                                EraseRect(theRect);
                                                                DrawString(aNum2Str(IntArray[i]));
                                                                oldIntArray[i] := IntArray[i];
                                                                updateSample := True;
                                                            end;

                                                        if updateSample & (Succ(i) mod 3 = 0) & (i < lastValIndex) then
                                                            begin
                                                                theRect := SampleRect;
                                                                OffsetRect(theRect, (40 * Succ(i)) + h + (32 - SampleRect.right), 0);
                                                                RGBForeColor(cPix);
                                                                PaintRect(theRect);
                                                                ForeColor(blackColor);

                                                                if CMenuPtr <> nil then
                                                                    begin
                                                                        RGBForeColor(CMenuPtr^.mctRGB1);
                                                                        RGBBackColor(CMenuPtr^.mctRGB4);
                                                                    end;

                                                                FrameRect(theRect);
                                                            end;

                                                        if Succ(i) mod 3 = 0 then
                                                            h := h + 30;
                                                    end;
                                                updateSample := False;
                                            end    { of (cPix.red <> oPix.red) | (cPix.green <> oPix.green) | (cPix.blue <> oPix.blue) }
                                        else
                                            CompareAndFixCursor;
                                    until not StillDown;
                                end;
                            otherwise
                        end;
                    until done;

                    CloseCPort(@p);
                    InitCursor;
                end
            else
                SysBeep(1);

            SetPort(savePort);            { restore grafport }
            DrawMenuBar;                    { fix menubar }
        end;    { main }


{$ifc fkey = false}

    begin
        main;

{$endc}

    end.